home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / e_SML / bootstrap / Make.sml < prev    next >
Encoding:
Text File  |  1997-07-24  |  15.2 KB  |  456 lines  |  [TEXT/R*ch]
  1. (* ****************************************************** *)
  2.  
  3. (* Make.sml *)
  4. (* 05Sep95 e *)
  5. (* 15Jun97 e -- modified to use second mosml for compiling;
  6.                 supports bootstrapping mosml142 *)
  7.  
  8. open List BasicIO;
  9.  
  10. (*
  11.  
  12. load "Path";
  13. load "Process";
  14.  
  15. val home =
  16.   case Process.getEnv "PATH_TRANSLATED" of
  17.     SOME n => Path.dir n
  18.   | NONE => ":"
  19. ;
  20.  
  21. load "Lexing";
  22. load "Nonstdio";
  23. load "Parsing";
  24. load "FileSys";
  25.  
  26. chDir (home ^ "src:compiler:");
  27. load "Config";
  28. load "Hasht";
  29.  
  30. chDir (home ^ "src:toolssrc:");
  31. load "Deppars";
  32. load "Deplex";
  33.  
  34. chDir (home ^ "e_SML:");
  35. load "Mosmlrun";
  36.  
  37. chDir home;
  38.  
  39. *)
  40.  
  41. (* portions stolen from... *)
  42.  
  43. (* Mosmldep -- computing dependencies in a Moscow ML source directory. *)
  44.  
  45. (* Lexer of stream *)
  46.  
  47. fun createLexerStream (is : instream) =
  48.   Lexing.createLexer (fn buff => fn n => Nonstdio.buff_input is buff 0 n)
  49. ;
  50.  
  51. fun parsePhraseAndClear parsingFun lexingFun lexbuf =
  52.   let val phr =
  53.     parsingFun lexingFun lexbuf
  54.     handle x => (Parsing.clearParser(); raise x)
  55.   in
  56.     Parsing.clearParser();
  57.     phr
  58.   end;
  59.  
  60. val parseFile =
  61.   parsePhraseAndClear Deppars.MLtext Deplex.Token;
  62.  
  63. fun addExt s ext = s ^ "." ^ ext;
  64.  
  65. (* now the new stuff... *)
  66.  
  67. (* 1- use Mosmldep to find each source file's dependencies
  68.    2- build some data structures (see below)
  69.    3- make the transitive closure of the dependencies
  70.    4- sort the files in dependency order
  71.    5- process each file in turn
  72.         checking modified times as documented below for function ensure
  73.         and compiling out-of-date files
  74.  
  75.   data structures...
  76.   after parsing: (objname,srcname,[objdeps],[moddeps]) called pd
  77.   closedeps calls pdltoa to make...
  78.   a hash table:   objname -> index                     called hn
  79.   and an array:   index -> pd                          called ap
  80.   and an array:   index -> [indexes of objdeps]        called di
  81.   closedeps makes
  82.       an array of indexes in dependency sorted order   called oi
  83.    and returns the value (n,hn,ap,di,oi)
  84.    where n is the length of the arrays
  85.   ensure uses n,hn,ap,di,oi to compile files needing it
  86.  
  87.   pd
  88.       objname is the name of the object file
  89.         .sml files generate .uo entry
  90.         .sig files generate .ui entry
  91.       srcname is the name of the file found in the directory
  92.       objdeps is a list of object files depended upon
  93.         dependency on a unit inserts
  94.           <unit>.ui into deps if <unit>.sig exists
  95.           otherwise <unit>.uo is inserted
  96.       moddeps is a list of units (not in this directory) depended upon
  97.  
  98.   read (the file parser) keeps a hash table of previously generated pd
  99.    it is keyed by srcname;
  100.    the modTime of the file is kept and checked to insure accuracy
  101.    this hashtable can be manually cleared with: reset_readht();
  102. *)
  103.  
  104. val moolevel = ref 1;
  105.  
  106. (* moolevel
  107. 0: no messages
  108. 1: error messages
  109. 2: compile messages
  110. 3: progress messages
  111. *)
  112.  
  113. fun moo v s1 s2 = if !moolevel >= v then (print s1; print s2; print "\n") else ();
  114. fun muu v s     = if !moolevel >= v then  print s                     else ();
  115.  
  116. fun pdltoa pdl =
  117.   let val hn = Hasht.new 37 : (string, int) Hasht.t
  118.       fun lp1 n r =
  119.         if (null r) then n
  120.         else let val (name,_,_,_) = (hd r)
  121.              in Hasht.insert hn name n;
  122.                 lp1 (n+1) (tl r)
  123.              end
  124.   in 
  125.     let val q  = lp1 0 pdl
  126.         val ap = Array.array(q,("","",[""],[""]))
  127.         val di = Array.array(q,[])
  128.         fun lp2 n r =
  129.           if (null r) then ()
  130.           else let val (name,_,ns,_) = (hd r)
  131.                in Array.update(ap,n,(hd r));
  132.                   Array.update(di,n,(List.map (Hasht.find hn) ns));
  133.                   lp2 (n+1) (tl r)
  134.                end
  135.     in
  136.       lp2 0 pdl;
  137.       (q,hn,ap,di)
  138.     end
  139.   end;
  140.  
  141. fun closedeps pdl =
  142.   let val (n,hn,ap,di) = pdltoa pdl
  143.       val dp = Array.array (n, []) (* dependents *)
  144.       val qd = Array.array (n, 0 ) (* dependencies *)
  145.       fun initdeps (deps,x) =
  146.         let fun idep m r =
  147.               if (null r) then m
  148.               else let val h = hd r
  149.                    in Array.update ( dp, h, x :: (Array.sub (dp, h)) );
  150.                       idep (m + 1) (tl r)
  151.                    end
  152.         in Array.update (qd, x, idep 0 deps);
  153.            x+1
  154.         end
  155.       val oi = Array.array (n, 0 )
  156.       val qi = ref 0 (* queue in *)
  157.       val ou = ref 0 (* queue out *)
  158.       fun enque x = (Array.update ( oi, !qi, x ); qi := !qi + 1)
  159.       fun pass1 i =
  160.         if (i = n) then ()
  161.         else let val x = Array.sub (qd, i)
  162.              in if ( x = 0 ) then enque i else ();
  163.                 pass1 (i + 1 )
  164.              end
  165.       fun pass2 r =
  166.         if (null r) then ()
  167.         else let val h = hd r
  168.                  val x = Array.sub (qd, h) - 1
  169.              in Array.update ( qd, h, x );
  170.                 if ( x = 0 ) then enque h else ();
  171.                 pass2 (tl r)
  172.              end
  173.       fun deque x = (pass2 (Array.sub (dp, x)); ou := !ou + 1)
  174.   in
  175.     moo 3 "\n" "Computing Dependencies";
  176.     Array.foldl initdeps 0 di;
  177.     pass1 0;
  178.     while ( !ou < !qi ) do deque (Array.sub (oi, !ou));
  179.     if (!ou = n)
  180.     then ()
  181.     else let val (nm,_,_,_) = Array.sub (ap,!ou)
  182.          in moo 1 "Circularity involving: "  nm;
  183.             raise (Fail "circle"); () 
  184.          end;
  185.     (n,hn,ap,di,oi)
  186.   end;
  187.  
  188. fun read' pdl srcext objext filename =
  189.   let val is       = open_in (addExt filename srcext)
  190.       val lexbuf   = createLexerStream is
  191.       val mentions = Hasht.new 37 : (string, unit) Hasht.t
  192.       val names    = parseFile lexbuf
  193.       val objlist = ref []
  194.       val modlist = ref []
  195.       fun adddep s =
  196.             if FileSys.access (addExt s "sig", []) then
  197.               objlist := addExt s "ui" :: !objlist
  198.             else if FileSys.access (addExt s "sml", []) then
  199.               objlist := addExt s "uo" :: !objlist
  200.         else (* libr or included dir files? *)
  201.           modlist := s :: !modlist
  202.   in 
  203.     close_in is;
  204.     List.app (fn name => Hasht.insert mentions name ()) names;
  205.     if srcext = "sml" andalso FileSys.access(addExt filename "sig", [])
  206.         then Hasht.insert mentions filename () else ();
  207.     Hasht.apply (fn name => fn _ => adddep name) mentions;
  208.     pdl := ((addExt filename objext),
  209.             (addExt filename srcext),
  210.             !objlist,
  211.             !modlist) :: !pdl
  212.   end
  213.   handle Parsing.ParseError _ => output(std_out, "Parseerror!\n");
  214.  
  215. val readht = ref (Hasht.new 67
  216.                   : (string, (Time.time *
  217.                               (string * string * string list * string list)))
  218.                   Hasht.t);
  219.  
  220. fun reset_readht _ =
  221.        readht := (Hasht.new 67
  222.                   : (string, (Time.time *
  223.                               (string * string * string list * string list)))
  224.                   Hasht.t);
  225.  
  226. fun read pdl srcext objext filename =
  227.   let val sn = (addExt filename srcext)
  228.       val mt = FileSys.modTime sn
  229.       fun dit s = muu 3 s
  230.       fun oops s =
  231.          ( dit s;
  232.            read' pdl srcext objext filename;
  233.            Hasht.insert (!readht) sn (mt,(hd (!pdl))) )
  234.   in
  235.     let val (tm,pd) = Hasht.find (!readht) sn
  236.     in
  237.       case (Time.compare (tm,mt)) of
  238.          EQUAL => ( dit "."; pdl := pd :: !pdl )
  239.        | _     => oops ";"
  240.     end
  241.     handle _ => oops ":"
  242.   end;
  243.  
  244. fun checkf srcext genext base =
  245.   let val gennam = (addExt base genext)
  246.       val havgen = (FileSys.access (gennam,[]))
  247.   in
  248.     if havgen then ()
  249.     else moo 2 "  warning: " ((addExt base srcext) ^ " but no: " ^ gennam)
  250.   end;
  251.  
  252. fun processfile pdl filename =
  253.   let val {base, ext} = Path.splitBaseExt filename
  254.       val base' = Path.file base
  255.   in 
  256.         case ext of
  257.             SOME "sig" =>  read pdl "sig" "ui" base'
  258.           | SOME "sml" =>  read pdl "sml" "uo" base'
  259.           | SOME "grm" => (checkf "grm" "sml" base'; checkf "grm" "sig" base')
  260.           | SOME "lex" =>  checkf "lex" "sml" base'
  261.           | SOME "mlp" =>  checkf "mlp" "sml" base'
  262.           | _          =>  ()
  263.   end;
  264.  
  265. (* ensure -- that a file is compiled if need be
  266.    1- if there is no object
  267.    2- if the mtime of the object is older than the epoch
  268.    3- if the mtime of the source is newer than mtime of the object
  269.    4- if the mtime of any dependency is newer than the mtime of the object
  270.    
  271.    the build order of the files is passed in oi
  272.    trick: we keep the mtime of each object in an array, timarr, indexed
  273.           by position in the initial list; since only files earlier in
  274.           the list can be depended upon, only their times are needed, so
  275.           mtimes of files are thereby memoized
  276.    dependencies on units outside the target directory are also checked
  277.     and memoized in a local hashtable
  278. *)
  279.  
  280. val make_lib = ref "";
  281. val make_perv = ref "-P none";
  282. val make_path = ref [] : string list ref;
  283. val find_path = ref [] : string list ref;
  284.  
  285. (* stolen from compiler/Mixture.sml *)
  286.  
  287. fun cannot_find filename =
  288.   raise (Fail ("Cannot find file "^filename))
  289. ;
  290.  
  291. fun file_exists filename =
  292.   FileSys.access (filename,[])
  293. ;
  294.  
  295. fun find_in_path filename =
  296.   if file_exists filename then
  297.     filename
  298.   else if Path.isAbsolute filename then
  299.     cannot_find filename
  300.   else
  301.     let fun h [] =
  302.               cannot_find filename
  303.           | h (a::rest) =
  304.               let val b = Path.joinDirFile { dir = a, file = filename } in
  305.                 if file_exists b then b else h rest
  306.               end
  307.     in h (!find_path) end
  308. ;
  309.  
  310. (* *)
  311.  
  312. fun perv_set set =
  313.   make_perv := ("-P " ^ set)
  314. ;
  315.  
  316. (*
  317. let open Mosmlrun in
  318. mosmlrun_compile "/StarMPW/ml/mosml142/lib/" "-P none" ["/StarMPW/ml/mosml142/src/compiler/"] "/StarMPW/ml/mosml142/src/compiler/Stack.sig"
  319.  handle MosmlrunErr(n,s) => print s
  320. end;
  321. *)
  322.  
  323. fun compile_ name =
  324.   let open Mosmlrun
  325.   in
  326.     ( print "Compiling: "; print name; print "\n" ) ;
  327.     mosmlrun_compile (!make_lib) (!make_perv) (!make_path) 
  328.                      ((hd (!make_path)) ^ name)
  329.      handle MosmlrunErr(n,s) => print s
  330.   end
  331. ;
  332.  
  333. fun ensure epoch (n,hn,ap,di,oi) =
  334.   let val timarr = Array.array(n,Time.zeroTime)
  335.       fun ftime x = Array.sub(timarr,x)
  336.       val itimes = Hasht.new 37 : (string, Time.time) Hasht.t
  337.       fun itime' m = 
  338.         let val uiname = (addExt m "ui")
  339.             val prname = find_in_path uiname
  340.         in moo 3 " checking: "  m;
  341.            FileSys.modTime prname
  342.         end handle Fail s => (moo 1 "  uncheck: " s; epoch)
  343.       fun itime m = Hasht.find itimes m
  344.                     handle Subscript =>
  345.                       let val i = itime' m  (* memoize! *)
  346.                       in Hasht.insert itimes m i; i end
  347.       fun nxt z =
  348.         if z >= n then ()
  349.         else let val x = Array.sub(oi,z)
  350.                  val (objname,srcname,objdeps,moddeps) = Array.sub(ap,x)
  351.                  val deps = Array.sub (di,x)
  352.              in
  353.                 if( FileSys.access (objname,[]) andalso
  354.                     let val otime = FileSys.modTime objname in
  355.                       Time.>(otime,epoch) andalso
  356.                       Time.>(otime,(FileSys.modTime srcname)) andalso
  357.                       (* this is conservative; too conservative if make is always used!
  358.                       (List.all (fn d => Time.>(otime,ftime d)) deps) andalso
  359.                       *)
  360.                       (List.all (fn d => Time.>=(otime,ftime d)) deps) andalso
  361.                       (List.all (fn d => Time.>(otime,itime d)) moddeps) andalso
  362.                       ( Array.update(timarr,x,otime); true )
  363.                     end )
  364.                 then moo 3 " ensuring: " objname
  365.                 else ( moo 2 "compiling: " objname;
  366.                        compile_ srcname;
  367.                        Array.update(timarr,x,FileSys.modTime objname) );
  368.                 nxt (z+1)
  369.              end
  370.   in nxt 0;
  371.      moo 3 "" ""
  372.   end;
  373.  
  374. fun make oset stdlib includes fpath mpath =
  375.   let open FileSys
  376.       val _   = if !moolevel < 0  (* kludgy way to reset table *)
  377.                 then (reset_readht(); moolevel := (~ (!moolevel)))
  378.                 else ()
  379.       val pdl = ref []
  380.       val dir = openDir mpath
  381.       val _   =   chDir mpath
  382.       fun read "" = ()
  383.         | read f  = ( processfile pdl f ; read (readDir dir) )
  384.       val _ = ( read (readDir dir); closeDir dir; () )
  385.               handle exn as OS.SysErr (msg, _) => (moo 1 msg ""; raise exn)
  386.       val nhnapdioi = closedeps (!pdl)
  387.   in
  388.     make_lib := stdlib;
  389.     make_path := (if stdlib <> ""
  390.                      then includes @ [stdlib]
  391.                      else includes);
  392.     perv_set (if oset <> "" then oset else "default");
  393.     find_path := fpath;
  394.     ensure Time.zeroTime nhnapdioi
  395.   end;
  396.  
  397. (*
  398.  
  399. moolevel := ~2;
  400.  
  401. make "none" "/StarMPW/ml/mosml142/lib/"
  402.            ["/StarMPW/ml/mosml142/src/compiler/"] []
  403.             "StarMPW:ml:mosml142:src:compiler"
  404. ;
  405.  
  406. make "none" "/StarMPW/ml/mosml142/lib/"
  407.            ["/StarMPW/ml/mosml142/src/lex/", "/StarMPW/ml/mosml142/src/compiler/"]
  408.            [] "StarMPW:ml:mosml142:src:lex"
  409. ;
  410.  
  411. :lib:mosmllnk -stdlib /StarMPW/ml/mosml142/lib/ -P none -g -I /StarMPW/ml/mosml142/src/compiler/ -I /StarMPW/ml/mosml142/src/lex/  -noheader -o mosmllex /StarMPW/ml/mosml142/src/lex/Mainlex.uo
  412.  
  413. make "none" "/StarMPW/ml/mosml142/lib/"
  414.            ["/StarMPW/ml/mosml142/src/toolssrc/", "/StarMPW/ml/mosml142/src/compiler/"]
  415.             [] "StarMPW:ml:mosml142:src:toolssrc"
  416. ;
  417.  
  418. :lib:mosmllnk -stdlib /StarMPW/ml/mosml142/lib/ -P none -g -I /StarMPW/ml/mosml142/src/compiler/ -I /StarMPW/ml/mosml142/src/toolssrc/ -I /StarMPW/ml/mosml142/src/lex/  -noheader -o mosmltope /StarMPW/ml/mosml142/src/toolssrc/Maine.uo
  419.  
  420. make "none -imptypes" "/StarMPW/ml/mosml142/src/mosmllib/"
  421.            ["/StarMPW/ml/mosml142/src/mosmllib/"]
  422.             [] "StarMPW:ml:mosml142:src:mosmllib"
  423. ;
  424.  
  425. make "none" "/StarMPW/ml/mosml142/src/mosmllib/"
  426.            ["/StarMPW/ml/mosml142/src/compiler/"]
  427.             ["StarMPW:ml:mosml142:src:mosmllib:"]
  428.              "StarMPW:ml:mosml142:src:compiler"
  429. ;
  430.  
  431. make "none" "/StarMPW/ml/mosml142/src/mosmllib/"
  432.            ["/StarMPW/ml/mosml142/src/lex/", "/StarMPW/ml/mosml142/src/compiler/"]
  433.             ["StarMPW:ml:mosml142:src:mosmllib:"] 
  434.              "StarMPW:ml:mosml142:src:lex"
  435. ;
  436.  
  437. make "none" "/StarMPW/ml/mosml142/src/mosmllib/"
  438.            ["/StarMPW/ml/mosml142/src/toolssrc/",
  439.             "/StarMPW/ml/mosml142/src/compiler/"]
  440.             ["StarMPW:ml:mosml142:src:compiler:",
  441.              "StarMPW:ml:mosml142:src:mosmllib:"]
  442.              "StarMPW:ml:mosml142:src:toolssrc"
  443. ;
  444.  
  445. :src:mosmllnk -stdlib /StarMPW/ml/mosml142/src/mosmllib/ -P none -g -I /StarMPW/ml/mosml142/src/compiler/ -I /StarMPW/ml/mosml142/src/toolssrc/ -I /StarMPW/ml/mosml142/src/lex/  -noheader -o mosmltope /StarMPW/ml/mosml142/src/toolssrc/Maine.uo
  446. :src:mosmllnk -stdlib /StarMPW/ml/mosml142/src/mosmllib/ -P none -g -I /StarMPW/ml/mosml142/src/compiler/ -I /StarMPW/ml/mosml142/src/lex/  -noheader -o mosmllex /StarMPW/ml/mosml142/src/lex/Mainlex.uo
  447. :src:mosmllnk -stdlib /StarMPW/ml/mosml142/src/mosmllib/ -P none -g -I /StarMPW/ml/mosml142/src/compiler/ -noheader -o mosmllink /StarMPW/ml/mosml142/src/compiler/Mainl.uo
  448.  
  449. mosmllink.image -stdlib StarMPW:ml:mosml142:src:mosmllib: -P none -g -I StarMPW:ml:mosml142:src:compiler: -I StarMPW:ml:mosml142:src:toolssrc: -I StarMPW:ml:mosml142:src:lex:  -noheader -o mosmltope StarMPW:ml:mosml142:src:toolssrc:Maine.uo
  450. mosmllink.image -stdlib StarMPW:ml:mosml142:src:mosmllib: -P none -g -I StarMPW:ml:mosml142:src:compiler: -I StarMPW:ml:mosml142:src:lex:  -noheader -o mosmllex StarMPW:ml:mosml142:src:lex:Mainlex.uo
  451. mosmllink.image -stdlib StarMPW:ml:mosml142:src:mosmllib: -P none -g -I StarMPW:ml:mosml142:src:compiler: -noheader -o mosmllink StarMPW:ml:mosml142:src:compiler:Mainl.uo
  452.  
  453. *)
  454.  
  455. (* ****************************************************** *)
  456.